perm filename CMANDS[G,BGB]1 blob sn#020184 filedate 1973-01-15 generic text, type T, neo UTF8
00100	;GEOMETRIC EDITOR COMMAND EXECUTION.
00200	;WING OPERATIONS.
00300	;	EXTERN MAKE,KILL
00400		EXTERN MKB,MKF,MKE,MKV,MKBFV
00500		EXTERN KLB,KLF,KLE,KLV,WING
00600		EXTERN WING,LINKED
00700		EXTERN ECW,ECCW,OTHER,OTHER.
00800		EXTERN BODY,FCW,FCCW,VCW,VCCW
00900	;EULER OPERATIONS.
01000		EXTERN MKEV
01100	
01200	
01300	;1. "V"-COMMAND.  MAKE VERTEX BODY.
01400	SUBR(VBODY)-------------------------------------------------------
01500	BEGIN VBODY;BGB 13 JANUARY 1973.
01600		A←1↔B←2↔C←3
01700		CALL(MKBFV)
01800		LAC B,PDLPTR
01900		PUSH B,A
02000		PFACE 0,A↔PUSH B,0
02100		PVT 0,A↔PUSH B,0
02200		DAC B,PDLPTR
02300		POP0J
02400	BEND;1/14/72------------------------------------------------------
     

00100	;2. "E"-COMMAND. SWEEP WIRE.
00200	SUBR(SWIRE)-------------------------------------------------------
00300	BEGIN SWIRE;BGB 14 JANUARY 1973.
00400		PTR←16
00500		CDR PTR,PDLPTR↔CAIG PTR,PADPDL↔POP0J	;PADPDL EMPTY.
00600		CALL(LINKED,{-1(PTR)},{(PTR)})		;ILLEGAL ARGS.
00700		SKIPN 1↔POP0J↔LAC PTR,PDLPTR
00800		CALL(MKEV,{-1(PTR)},{(PTR)})
00900		LAC PTR,PDLPTR↔DAC 1,(PTR)↔POP0J	;REPLACE TOP.
01000	BEND;1/14/72------------------------------------------------------
     

00100	;3. ":;()-*" COMMANDS. EUCLIDEAN TRANSFORMATION COMMANDS.
00200	SUBR(EUTRAN)------------------------------------------------------
00300	BEGIN EUTRAN;BGB 15 JANUARY 1973.
00400	
00500		CDR 1,PDLPTR↔CAIGE 1,PADPDL↔POP0J
00600		LAC(1)↔DAC OBJECT
00700	
00800	;OPERATION CODE.
00900		SETZ
01000		SKIPE CTRL↔IORI 100
01100		SKIPE META↔IORI 200
01200		SKIPN↔IORI OPERAT	;DEFAULT OPERATION.
01300	;AXIS CODE.
01400		LAC 1,CHR
01500		CAIE 1,"("↔CAIN 1,")"↔IORI 010
01600		CAIE 1,"-"↔CAIN 1,"*"↔IORI 020
01700	;AXIS MODIFIER.
01800		IOR AXECNT↔DAC OPAXCNT
01900	;DELTA ARGUMENT.
02000		LAC 2,TDEL↔TRNE 100↔LAC 2,RDEL↔TRNE 200↔LAC 2,DDEL
02100		CAIN 1,"-"↔MOVNS 2
02200		CAIN 1,"("↔MOVNS 2
02300		CAIN 1,";"↔MOVNS 2
02400	
02500	;GET REFERENCE FRAME.
02600	
02700	;MAKE EUCLIDEAN TRANSFORMATION.
02800		SETQ(TRAN,{MKTRAN,REFRAM,OPAXCNT,DELTA})
02900	
03000	;APPLY EUCLIDEAN TRANSFORMATION.
03100	
03200	L:	CALL(APTRAN,OBJECT,TRAN)
03300		CALL(DPYSUB)
03400		SOSLE COUNT↔GO L
03500	
03600		DECLARE{OBJECT,TRAN,REFRAM,OPAXCNT,DELTA,COUNT}
03700	BEND;1/15/72------------------------------------------------------